home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000 #2
/
Ham Radio 2000 - Volume 2.iso
/
HAMV2
/
MISC
/
TSTHFLT2
/
CHECK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-12-01
|
10KB
|
279 lines
{(s0p16h0s0b4099T}
Program Con_filt;
{
This program is a PG utillity for TSTHOST 1.41 and higher.
This program access TSTHOST for information about the status of the
program and the tasks. Extended data request will be done trought the
internally IQR service vector, normally 101, 65Hex. This vector
may be redefined with the command TSTHOST/V, that accept in input a
DECIMAL value. This program is tested with TSTHOST 1.43b.
Written by Reg, PE1PKD, BLOKKER in HOLLAND.
Packet address : PE1PKD @ PI8WFL.#NH1.NLD.EU
}
Uses Dos;
Type
InfoRec = Record
(* This record is translated from the C layout from the manual into
Turbo Pascal layout. The record names are exactly the same as
described in the manual.*)
(* THIS VALUE ARE GLOBALS, NOT CHANNEL DEPANDANT.*)
(*=============================================== *)
THVH : Byte; (*TstHost version, high value*)
THVL : Byte; (*TstHost version, low value*)
MAXCHANNEL : Integer; (*Number of channel available i tsthost*)
DRVTYPE : Byte; (*Driver type, 1 real host, 0 tfpc, 2 drsi*)
PORT : Byte; (*If real host, com port*)
BAUDRATE : Word; (*If real host, baudrate*)
INTNO : Integer; (*If tfpcx/r, irq vector used by driver*)
TstHostCall : Array[0..9] of Char; (*Callsign of the sistem, with ssid*)
UListEnable : Byte; (*If not 0, unproto list is active*)
Wpath : Array[0..80] of Char; (*tsthost WorkDir*)
Upath : Array[0..100] of Char; (*tsthost UserDir. If more than one path*)
(*is defined, the multiple path are*)
(*separated by a space.*)
HomeBbs : Array[0..9] of Char; (*HomeBbs Callsign*)
HomeAlias : Array[0..9] of Char; (*homebbs alias call, null if undefined*)
(* THIS FIELDS ARE CHANNEL DEPANDANT*)
(*====================================================*)
Chstatus : Integer; (*0 channel is disconnected*)
(*1 standard connection, I have connect*)
(* another OM*)
(*2 PMS connection, a remote user is*)
(* connected on my pms*)
(*3 PMS connection, HomeBbs have connect*)
(* my pms to do forward.*)
(*4 PMS connection, my pms have connect*)
(* HomeBbs to do forward*)
(*5 UNPROTO connection, i have connect*)
(* HomeBbs to request unproto mail.*)
SuppCall : Array[0..9] of Char; (*If not null, extra callsign for the*)
(*channel (command AX PORT)*)
UserCall : Array[0..9] of Char; (*call of the connected station, with ssid*)
(* THIS FIELDS ARE VALID ONLY FOR USER THAT HAVE CONNECT*)
(* MY PMS, chstatus=2 o 3*)
(*=====================================================*)
UIname : Array[0..12] of Char; (*User name*)
UILastConnTime : LongInt; (*in sec dal 1970, last connection date*)
UILastMsgList : LongInt; (*in sec, last messaged listed date*)
UINbrConn : LongInt; (*number of connection for this user*)
UIThisConnTime : LongInt; (*in second, this date at connection*)
SysFlag : Word; (*actual SYS flag for the user*)
End;
ChannelList = Array[0..8] of InfoRec;
Var
Reg : Registers;
Point : ^InfoRec ; {typed pointer}
ChannelData : ChannelList; {all record data off the channels}
TsthostPath : String; {path where TSHOST.EXE is located}
TsthostIRQVector : Byte; {IRQ vector to get the info}
{WARNING : This is NOT the IRQ vector for
communication to e.g. TFPCX(286) driver!}
Function GetTsthostPath : String;
{ This function is returning the path where tsthost.exe is located. }
Var
PathName : PathStr;
DirName : Dirstr;
ProgName : NameStr;
ExtName : ExtStr;
DirInfo : SearchRec;
PGPos : Byte;
Begin
PathName := Fexpand(ParamStr(0));
FSplit(PathName,DirName,ProgName,ExtName);
PGPos := Pos('PG',DirName);
If PGPos = 0 then GetTsthostPath := 'C:\TSTHOST\'
else GetTsthostPath := Copy(DirName,1,PGPos-1);
End;
Procedure GetInfo(TsthostIRQ : Byte; ALByte : Byte);
{ This procedure gets the information from the memory location.
WARNING : On page 8 of the TSHOST 1.43 manual is mensioned that
register AH is set to the specified channel to investigate. This must
be register AL! }
Begin
With Reg do
Begin
AL := ALByte;
AH := 0;
Intr(TsthostIRQ, Reg);
If AH <> 0 Then {When returning AH must be 0}
Begin
Writeln('Can not connect to TSTHOST.');
Halt(0);
End;
Point := Ptr(ES,BX);
{
Writeln('AL ',AL);
Writeln('AH ',AH);
}
End;
End;
Procedure WriteInfo;
{ Temporally procedure to display the data }
Begin
With Point^ do
Begin
Writeln ('THVH>>>',THVH,'<<<');
Writeln ('THVL>>>',THVL,'<<<');
Writeln ('MAXCHANNEL >>>',MAXCHANNEL,'<<<');
Writeln ('DRVTYPE >>>',DRVTYPE,'<<<');
Writeln ('PORT >>>',PORT,'<<<');
Writeln ('BAUDRATE >>>',BAUDRATE,'<<<');
Writeln ('INTNO >>>',INTNO,'<<<');
Writeln ('TstHostCall >>>',TstHostCall,'<<<');
Writeln ('UListEnable >>>',UListEnable,'<<<');
Writeln ('Wpath >>>',Wpath,'<<<');
Writeln ('Upath >>>',Upath,'<<<');
Writeln ('HomeBbs >>>',HomeBbs,'<<<');
Writeln ('HomeAlias >>>',HomeAlias,'<<<');
Writeln ('Chstatus >>>',chstatus,'<<<');
Writeln ('SuppCall >>>',SuppCall,'<<<');
Writeln ('UserCall >>>',UserCall,'<<<');
Writeln ('UIname >>>',UIname,'<<<');
Writeln ('UILastConnTime>>>',UILastConnTime,'<<<');
Writeln ('UILastMsgList >>>',UILastMsgList,'<<<');
Writeln ('UINbrConn >>>',UINbrConn,'<<<');
Writeln ('UIThisConnTime>>>',UIThisConnTime,'<<<');
Writeln ('SysFlag >>>',SysFlag,'<<<');
End;
End;
Function ReadTsthostInterruptVector : Byte;
{ Read the IRQ vector from file TSTHOST.IRQ. This file only exist
when TSTHOST is started. This procedure checks or file exist and
so if TSTHOST is started.}
Var
IRQString,
Line,
TstHostIRQName : String;
TsthostIRQRead : Text;
DirInfo : SearchRec;
IRQNumber,
Code : Integer;
IRQPos : Byte;
Begin
(* First check or this program is called under tsthost operation! *)
TsthostIRQName := GettsthostPath + 'TSTHOST.IRQ';
FindFirst(TsthostIRQName,AnyFile,DirInfo);
If DosError > 0 then
Begin
Writeln('This programm requires TSTHOST.');
Halt(0);
End;
Assign(TsthostIRQRead, TsthostIRQName);
{$I-}
Reset(TsthostIRQRead);
{SI+}
If IOResult <> 0 then
Begin
Writeln('Error reading file :',TsthostIRQName);
Halt(0);
End;
Repeat
Readln(TsthostIRQRead,Line);
IRQPos := Pos('=',Line);
IRQString := Copy(Line,IRQPos+1,3);
Val(IRQString,IRQNumber,Code);
If (IRQPos = 0) or (Code <> 0) Then
Begin
Writeln('Error reading file :',TsthostIRQName);
Halt(0);
End;
Until Eof(TsthostIRQRead);
Close(TsthostIRQRead);
ReadTsthostInterruptVector := IRQNumber;
End;
Procedure ScanChannels;
{ Scans all channels and get the data }
Var
Channel : Byte;
Begin
GetInfo(TsthostIRQVector,0); {First scan the MONITOR channel}
ChannelData[0] := Point^; {Write data from memory in record}
For Channel := 1 to ChannelData[0].MaxChannel do { Scan the channels 1 to max.}
Begin
GetInfo(TsthostIRQVector,Channel);
ChannelData[Channel] := Point^;
{ WriteInfo; }
End;
End;
Procedure DisplayStatus;
Var
Channel : Byte;
Begin
For Channel := 1 to ChannelData[0].MaxChannel do { Scan the channels 1 to max.}
Begin
With ChannelData[Channel] do
Begin
Writeln('***Ch>>>',Channel,'<<<');
Writeln ('THVH>>>',THVH,'<<<');
Writeln ('THVL>>>',THVL,'<<<');
Writeln ('MAXCHANNEL >>>',MAXCHANNEL,'<<<');
Writeln ('DRVTYPE >>>',DRVTYPE,'<<<');
Writeln ('PORT >>>',PORT,'<<<');
Writeln ('BAUDRATE >>>',BAUDRATE,'<<<');
Writeln ('INTNO >>>',INTNO,'<<<');
Writeln ('TstHostCall >>>',TstHostCall,'<<<');
Writeln ('UListEnable >>>',UListEnable,'<<<');
Writeln ('Wpath >>>',Wpath,'<<<');
Writeln ('Upath >>>',Upath,'<<<');
Writeln ('HomeBbs >>>',HomeBbs,'<<<');
Writeln ('HomeAlias >>>',HomeAlias,'<<<');
Writeln ('Chstatus >>>',chstatus,'<<<');
Writeln ('SuppCall >>>',SuppCall,'<<<');
Writeln ('UserCall >>>',UserCall,'<<<');
Writeln ('UIname >>>',UIname,'<<<');
Writeln ('UILastConnTime>>>',UILastConnTime,'<<<');
Writeln ('UILastMsgList >>>',UILastMsgList,'<<<');
Writeln ('UINbrConn >>>',UINbrConn,'<<<');
Writeln ('UIThisConnTime>>>',UIThisConnTime,'<<<');
Writeln ('SysFlag >>>',SysFlag,'<<<');
End;
End;
End;
Begin { main }
TsthostIRQVector := ReadTsthostInterruptVector;
ScanChannels;
DisplayStatus;
End.